;;; For remote control of the GUI.

(in-package :gwee)

(defvar *remote-process* nil)

#+lispworks
(defun remote-init ()
  (unless *remote-process*
    (setf *remote-process* (process-run-function "Slime" (lambda () (swank:create-server :port (1+ swank::default-server-port) :dont-close nil :style nil))))))

#+(or lispworks)
(defun remote-eval (sexp)
  ;; To create the illusion of synchronous execution, stop the current
  ;; process and then have the remotely executed command unstop it.
  (let ((process (current-process))
        answer)
    (if (eq process *remote-process*)
        (progn
          (gwee:enqueue (lambda ()
                          ;; FIXME: deal with the errors better
                          (unwind-protect
                               (setf answer (multiple-value-list (handler-case (eval sexp) (error (c) c))))
                            (process-start process))))
          (process-stop process)
          (when (typep (first answer) 'condition)
            (error (first answer)))
          (values-list answer))
        (eval sexp))))

#+sbcl
(defun remote-init ()
  (swank:create-server :port (1+ swank::default-server-port) :dont-close nil :style :fd-handler))

#+sbcl
(defun remote-eval (sexp)
  (error "remote-eval Doesn't work in sbcl."))

#+ccl
(defun remote-init ()
  #+swank
  (swank:create-server :port (1+ swank::default-server-port) :dont-close nil :style :spawn))

#+ccl
(defun remote-eval (sexp)
  (error "remote-eval Doesn't work in CCL."))

(defvar *remote-eval-lock* (make-lock))

#+allegro
(defun remote-eval (sexp)
  "Only one process can remote eval at a time. Not ideal but also
likely to be the only scenario. opening the gate during a non-local
exit was making ACL slow and even hanging 8.1. So now we use a global
remote-eval gate, which means only one process can use it at a time."
  (with-lock (*remote-eval-lock*)
  (let ((process (current-process))
        answer
        error)
    (gwee:enqueue (lambda ()
		    (setf answer (multiple-value-list (handler-case (eval sexp)
								    (error (c)
									   (setf error c)))))))
    (mp:close-gate *idle-queue-ret-gate*)
    (mp:open-gate *idle-queue-gate*)
    (mp:process-wait "Waiting for remote eval" #'mp:gate-open-p *idle-queue-ret-gate*)
    (if error
        (error error)
        (values-list answer)))))

#-(or lispworks ccl sbcl allegro)
(defun remote-init ()
  (error "remote-init: unimplemented"))

#-(or lispworks ccl sbcl allegro)
(defun remote-eval (sexp)
  (error "remote-eval: unimplemented."))
